home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / apps / 439 / draw3 / draw3.lst next >
File List  |  1990-11-30  |  7KB  |  246 lines
  1. ` Drawing program using mouse and mouse buttons
  2. ' by E.C. Smith July 23, 1989 for S.P.A.C.E ST SIG
  3. '
  4. Dim X%(16) !Array to hold x coordinates of the color boxes displayed
  5. Dim Sx%(4) !Array to hold x coordinates of the size boxes
  6. Offset%=4950  !Draw on lower portion of screen only
  7. R%=10 !Initial radius of circles
  8. S%=10 !Initial side of squares
  9. C%=1  !Establish color register 1 to start
  10. W4%=36         ! width  of a 4 letter box
  11. H4%=10         ! height "  " "   "     "
  12. Xq%=0          ! location of
  13. Yq%=0          ! quit box
  14. Brush%=2       ! Brush size is a fine point
  15. R%=10          ! Set radius
  16. Wbr%=248       ! width of brush selection screen
  17. Hbr%=120       !  height of brush selection screen
  18. Xbr%=16        ! location of
  19. Ybr%=40        ! brush selection screen
  20. Xclr%=0        ! location
  21. Yclr%=11       ! clear screen box
  22. Xsave%=W4%+4   ! location of
  23. Ysave%=0       ! save box
  24. Xload%=W4%+4   ! location of
  25. Yload%=11      ! load box
  26. Xbrsh%=2*W4%+8 ! location of
  27. Ybrsh%=11      ! Brsh box
  28. Get 0,0,W4%,H4%,X4$                  ! Size of 4 letter box
  29. Mid$(X4$,7)=String$(Len(X4$),255)    ! Fill X4$ with binary one"s
  30. Get 0,0,Wbr%,Hbr%,Blank$
  31. Mid$(Blank$,7)=String$(Len(Blank$),0)
  32. W%=10          ! width of color box
  33. H%=10          ! height of color box
  34. D%=8           ! distance between boxes
  35. X1%=19         ! leftmost color box position
  36. Y1%=22         ! distance from top of screen
  37. @Plot_upper_screen
  38. Do   !  DO loop to look for mouse button press (left or right buttons)
  39.   Inc I%       ! increment to next color box
  40.   If I%>15     ! Only 16 boxes possible (0 to 15)
  41.     I%=0
  42.   Endif
  43.   Xa%=X%(I%)   ! Get X% location of box I%
  44.   K%=Mousek    ! Look for press of mouse button
  45.   X%=Mousex    ! Get location of
  46.   Y%=Mousey    ! mouse on screen
  47.   If X%>Xa% And X%<Xa%+W% And Y%<Y1%+H% And Y%>Y1% And K%=1
  48.     C%=Point(X%,Y%) ! Color box was entered, get color value of this box
  49.   Endif
  50.   If X%>Xq% And X%<Xq%+W4% And Y%<Yq%+H4% And Y%>Yq% And K%=1
  51.     Done!=True      ! quit box was entered, we are done!
  52.     Put Xq%,Yq%,X4$,6
  53.   Endif
  54.   If X%>Xsave% And X%<Xsave%+W4% And Y%<Ysave%+H4% And Y%>Ysave% And K%=1
  55.     Put Xsave%,Ysave%,X4$,6 ! Save box was entered
  56.     @Get_default_drive
  57.     @Get_filename
  58.     If Not Cancel!
  59.       Print At(21,2);"Saving file "
  60.       Bsave File$,Xbios(2)+Offset%,32000-Offset%
  61.     Endif
  62.     Put Xsave%,Ysave%,X4$,6
  63.     Print At(21,2);"           "
  64.   Endif
  65.   If X%>Xload% And X%<Xload%+W4% And Y%<Yload%+H4% And Y%>Yload% And K%=1
  66.     Put Xload%,Yload%,X4$,6 ! Load box was entered
  67.     @Get_default_drive
  68.     @Get_filename
  69.     If (Not Cancel!) And (Exist(File$))
  70.       Print At(21,2);"Loading File"
  71.       Bload File$,Xbios(2)+Offset%
  72.     Endif
  73.     Put Xload%,Yload%,X4$,6
  74.     Print At(21,2);"             "
  75.   Endif
  76.   If X%>Xbrsh% And X%<Xbrsh%+W4% And Y%<Ybrsh%+H4% And Y%>Ybrsh% And K%=1
  77.     Put Xbrsh%,Ybrsh%,X4$,6 ! Brsh box was entered
  78.     Get Xbr%,Ybr%,Xbr%+Wbr%,Ybr%+Hbr%,Y$ ! get screen
  79.     Put Xbr%,Ybr%,Blank$ ! Replace screen with blank
  80.     Deffill C%
  81.     Color C%
  82.     Box Xbr%,Ybr%,Xbr%+Wbr%,Ybr%+Hbr% ! Draw border box
  83.     Box Xbr%+4,Ybr%+4,Xbr%+Wbr%-4,Ybr%+Hbr%-4 ! Draw inside border box
  84.     @Get_brush(C%) ! Get brush% r% or s%
  85.     Put Xbr%,Ybr%,Y$ !    Restore screen
  86.     Put Xbrsh%,Ybrsh%,X4$,6 ! outen Brsh box
  87.   Endif
  88.   If X%>Xclr% And X%<Xclr%+W4% And Y%<Yclr%+H4% And Y%>Yclr% And K%=1
  89.     Put Xclr%,Yclr%,X4$,6 !ClrS box entered
  90.     Cls
  91.     @Plot_upper_screen
  92.   Endif
  93.   If K%=1 And Y%>Y1%+H%
  94.     Color C% !    Plot color by pressing left button
  95.     On Brush% Gosub Solid_cir,Empty_cir,Solid_squ,Empty_squ
  96.   Endif
  97.   Exit If Done!   ! Exit by clicking on exit box
  98. Loop
  99. End
  100. Procedure Get_filename
  101.   Cancel!=False
  102.   Fs$=Drv$+"\*.pix"
  103.   Repeat
  104.     Fileselect Fs$,B$,File$
  105.   Until File$<>Drv$+"\"
  106.   If File$=""
  107.     Cancel!=True
  108.   Endif
  109. Return
  110. Procedure Get_default_drive
  111.   Drv$=Chr$(Gemdos(25)+65)+":"
  112. Return
  113. Procedure Plot_upper_screen
  114.   Box Xq%,Yq%,Xq%+W4%,Yq%+H4%             ! Plot quit box
  115.   Text Xq%+2,Yq%+H4%-2,"Quit"             ! Put text in box
  116.   Box Xsave%,Ysave%,Xsave%+W4%,Ysave%+H4% ! Plot Save box
  117.   Text Xsave%+2,Ysave%+H4%-2,"Save"       ! Put text in box
  118.   Box Xload%,Yload%,Xload%+W4%,Yload%+H4% ! Plot load box
  119.   Text Xload%+2,Yload%+H4%-2,"Load"       ! Put text in box
  120.   Box Xclr%,Yclr%,Xclr%+W4%,Yclr%+H4%     ! Plot ClrS box
  121.   Text Xclr%+2,Yclr%+H4%-2,"ClrS"         ! Put text in box
  122.   Box Xbrsh%,Ybrsh%,Xbrsh%+W4%,Ybrsh%+H4% ! Plot Brsh box
  123.   Text Xbrsh%+2,Ybrsh%+H4%-2,"Brsh"       ! Put text in box
  124.   For I%=0 To 15  !           This FOR NEXT loop
  125.     X%=X1%+(W%+D%)*I%
  126.     X%(I%)=X%     !           plots 16 color boxes
  127.     Color I%
  128.     Deffill I%
  129.     Pbox X%,Y1%,X%+W%,Y1%+H% !  across the upper portion of the screen.
  130.     If I%<4
  131.       Sx%(I%)=Xbr%+16+60*I%  ! Fill Size box array (X% values)
  132.     Endif
  133.   Next I%
  134. Return
  135. Procedure Solid_cir
  136.   Deffill C%
  137.   Pcircle X%,Y%,R%
  138. Return
  139. Procedure Empty_cir
  140.   Deffill C%
  141.   If R%<>1
  142.     Circle X%,Y%,R%
  143.   Else
  144.     Plot X%,Y%
  145.   Endif
  146. Return
  147. Procedure Solid_squ
  148.   Deffill C%
  149.   Pbox X%,Y%,X%+S%,Y%+S%
  150. Return
  151. Procedure Empty_squ
  152.   Deffill C%
  153.   Box X%,Y%,X%+S%,Y%+S%
  154. Return
  155. Procedure Get_brush(C%)
  156.   ' Determine brush%=1 to 4 and values for r% and s%
  157.   Gotbrush!=False
  158.   Print At(4,7);"B R U S H   S E L E C T I O N"
  159.   Print At(4,8);"To adjust brush size click on"
  160.   Print At(4,9);"Size box using left button"
  161.   Print At(4,10);"until satisfied."
  162.   Print At(4,18);"To select a brush click on"
  163.   Print At(4,19);"Size box using right button"
  164.   Pcircle Xbr%+40,Ybr%+70,R%
  165.   Circle Xbr%+100,Ybr%+70,R%
  166.   Pbox Xbr%+150,Ybr%+70-R%/2,Xbr%+150+S%,Ybr%+70+S%-R%/2
  167.   Box Xbr%+200,Ybr%+70-R%/2,Xbr%+200+S%,Ybr%+70+S%-R%/2
  168.   Ysize%=Ybr%+84
  169.   For I%=0 To 3
  170.     Box Sx%(I%),Ysize%,Sx%(I%)+W4%,Ysize%+H4%
  171.     Text Sx%(I%)+2,Ysize%+H4%-2,"Size"
  172.   Next I%
  173.   I%=0
  174.   @Circle2
  175.   I%=1
  176.   @Circle2
  177.   I%=2
  178.   @Square2
  179.   I%=3
  180.   @Square2
  181.   Do
  182.     Inc I%
  183.     If I%>3
  184.       I%=0
  185.     Endif
  186.     X%=Mousex
  187.     Y%=Mousey
  188.     K%=Mousek
  189.     If X%>Sx%(I%) And X%<Sx%(I%)+W4% And Y%<Ysize%+H4% And Y%>Ysize%
  190.       If K%=2
  191.         Brush%=I%+1
  192.         Gotbrush!=True
  193.       Endif
  194.       If K%=1 And I%<2
  195.         Inc R%
  196.         If R%>14
  197.           R%=1
  198.         Endif
  199.         @Circle2
  200.         If I%=0
  201.           Deffill 0
  202.           Pcircle Xbr%+40,Ybr%+70,14
  203.           Deffill C%
  204.           Pcircle Xbr%+40,Ybr%+70,R%
  205.         Endif
  206.         If I%=1
  207.           Deffill 0
  208.           Pcircle Xbr%+100,Ybr%+70,14
  209.           Deffill C%
  210.           Circle Xbr%+100,Ybr%+70,R%
  211.         Endif
  212.       Endif
  213.       If K%=1 And I%>1
  214.         Inc S%
  215.         If S%>14
  216.           S%=1
  217.         Endif
  218.         @Square2
  219.         If I%=2
  220.           Deffill 0
  221.           Pbox Xbr%+150,Ybr%+70-R%/2,Xbr%+164,Ybr%+84-R%/2
  222.           Deffill C%
  223.           Pbox Xbr%+150,Ybr%+70-R%/2,Xbr%+150+S%,Ybr%+70+S%-R%/2
  224.         Endif
  225.         If I%=3
  226.           Deffill 0
  227.           Pbox Xbr%+200,Ybr%+70-R%/2,Xbr%+214,Ybr%+84-R%/2
  228.           Deffill C%
  229.           Box Xbr%+200,Ybr%+70-R%/2,Xbr%+200+S%,Ybr%+70+S%-R%/2
  230.         Endif
  231.       Endif
  232.     Endif
  233.     Exit If Gotbrush!
  234.   Loop
  235. Return
  236. Procedure Circle2
  237.   L%=5*(I%=0)*(-1)+13*(I%=1)*(-1)
  238.   Print At(L%,12);"     "
  239.   Print At(L%,12);C%;" ";R%
  240. Return
  241. Procedure Square2
  242.   L%=20*(I%=2)*(-1)+27*(I%=3)*(-1)
  243.   Print At(L%,12);"     "
  244.   Print At(L%,12);C%;" ";S%
  245. Return
  246.